home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / SML⁄NJ 93+ / Documentation / examples / textbooks / reade / charpics.sml < prev    next >
Encoding:
Text File  |  1995-12-30  |  9.3 KB  |  72 lines  |  [TEXT/R*ch]
  1.  
  2. (***********************************************************************
  3.  | Structure Charpics containing ABSTRACT TYPE PICTURE                 |
  4.  |                                                                     |
  5.  | (Uses Chrisprelude)                                                 |
  6.  |                                                                     |
  7.  | C.M.P.Reade      Oct 1987                                           |
  8.  |                                                                     |
  9.  | (Comments at End)                                                   |
  10.  ***********************************************************************)
  11.  
  12. structure Charpics = struct
  13.  
  14.  
  15. local open Chrisprelude; infix upto in
  16.  
  17. abstype picture = Pic of int * int * string list
  18. with
  19.      fun mkpic linelist 
  20.                = let val d = length linelist;
  21.                      val shape = map size linelist;
  22.                      val w = maxposlist shape;
  23.                      fun addspaces line = let val a = size line in
  24.                                            if a<w then line^spaces(w-a) 
  25.                                                   else line
  26.                                           end;
  27.                      val checkedlines = map addspaces linelist
  28.                  in Pic(d,w,checkedlines) end;
  29.  
  30.      fun depth (Pic(d,_,_)) = d;
  31.      fun width (Pic(_,w,_)) = w;
  32.      fun linesof (Pic(_,_,sl)) = sl;
  33.      val nullpic = Pic(0,0,[]);
  34.      fun padside n (pic as Pic(d,w,sl))
  35.           = if n <= w then pic
  36.                       else Pic(d,n,map (fn s=>s^spaces(n-w)) sl);
  37.      fun padbottom n (pic as Pic(d,w,sl))
  38.           = if n <= d then pic
  39.                       else Pic(n,w,sl @ copy (n-d) (spaces w));
  40.     fun rowwith fsb piclist 
  41.           = let val d' = maxposlist(map depth piclist);
  42.                 val blocks = map (linesof o padbottom d') piclist;
  43.                 fun mkline n = stringwith fsb (map (select n) blocks);
  44.                 val sl' = map mkline (1 upto d');
  45.                 val w' = if null sl' then 0 else size(hd sl')
  46.             in Pic(d',w',sl') end;
  47.  
  48.     val row = rowwith ("","","");
  49.  
  50.     fun colwith (f,s,b) piclist
  51.           = let val w' = maxposlist(map width piclist);
  52.                 val flines = map (implode o (copy w')) (explode f);
  53.                 val slines = map (implode o (copy w')) (explode s);
  54.                 val blines = map (implode o (copy w')) (explode b);
  55.                 val sl' = linkwith(flines,slines,blines)
  56.                                   (map (linesof o padside w') piclist);
  57.                 val d' = length sl'
  58.              in Pic(d',w',sl') end;
  59.  
  60.     val column = colwith ("","","");
  61.  
  62.     fun indent n (pic as Pic(d,w,sl))
  63.                = if n<1 then pic
  64.                         else Pic(d,w+n,map (concat(spaces n)) sl);
  65.  
  66.     fun lower n (pic as Pic(d,w,sl))
  67.                = if n<1 then pic
  68.                         else Pic(d+n,w,copy n (spaces w) @ sl);
  69.  
  70.    fun table [] = nullpic |
  71.        table piclistlist 
  72.                 = let fun mkrect piclistlist  (* makes sure each list has same length